Aminet 1/Aminet - June 1993 [Walnut Creek].iso/usenet/sources/volume90/unix/cpp/part05

Internet Message Format | 1990-01-18 | 36.3 KB

Path: xanth!cs.odu.edu!Amiga-Request
From: [e-mail] (Amiga Sources/Binaries Moderator)
Newsgroups: comp.sources.amiga
Subject: v90i026: cpp - a c preprocessor with some ANSI features, Part05/05
Message-ID: <[e-mail]>
Date: 18 Jan 90 00:23:22 GMT
Sender: [e-mail]
Reply-To: Olaf 'Rhialto' Seibert <[e-mail]>
Lines: 1223
Approved: [e-mail] (Tad Guy)

Submitted-by: Olaf 'Rhialto' Seibert <[e-mail]>
Posting-number: Volume 90, Issue 026
Archive-name: unix/cpp/part05

#!/bin/sh
# This is a shell archive.  Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file".  To overwrite existing
# files, type "sh file -c".  You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g..  If this archive is complete, you
# will see the following message at the end:
#        "End of archive 5 (of 5)."
# Contents:  Cpp6.c
# Wrapped by tadguy@xanth on Wed Jan 17 19:17:38 1990
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'Cpp6.c' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'Cpp6.c'\"
else
echo shar: Extracting \"'Cpp6.c'\" \(33823 characters\)
sed "s/^X//" >'Cpp6.c' <<'END_OF_FILE'
X/*
X *                C P P 6 . C
X *        S u p p o r t    R o u t i n e s
X *
X * Edit History
X * 25-May-84 MM     Added 8-bit support to type table.
X * 30-May-84 ARF    sharp() should output filename in quotes
X * 02-Aug-84 MM     Newline and #line hacking.  sharp() now in cpp1.c
X * 31-Aug-84 MM     USENET net.sources release
X * 11-Sep-84 ado/MM    Keepcomments, also line number pathological
X * 12-Sep-84 ado/MM    bug if comment changes to space and we unget later.
X * 03-Oct-84 gkr/MM    Fixed scannumber bug for '.e' (as in struct.element).
X * 04-Oct-84 MM     Added ungetstring() for token concatenation
X * 08-Oct-84 MM     Yet another attack on number scanning
X * 31-Oct-84 ado    Parameterized $ in identifiers
X *  2-Nov-84 MM     Token concatenation is messier than I thought
X *  6-Dec-84 MM     \<nl> is everywhere invisible.
X * 21-Oct-85 RMS    Rename `token' to `tokenbuf'.
X *            Dynamically allocate it, and make it as big as needed.
X * 23-Oct-85 RMS    Fix bugs storing into tokenbuf as it gets bigger.
X *            Change error msg to  cpp: "FILE", line LINE: MSG
X * 24-Oct-85 RMS    Turn off warnings about / then * inside a comment.
X * 16-Mar-86 FNF    Incorporate macro based C debugging package.
X *            Port to Commodore Amiga.
X * 20-Aug-88 Ois    Added time routines (or actually deleted stubs).
X * 20-Aug-88 Ois    Changed handling of token following ## to match Cpp4.
X */
X
X#include    <stdio.h>
X#include    <ctype.h>
X#include    "cppdef.h"
X#include    "cpp.h"
X
X/*
X * skipnl()     skips over input text to the end of the line.
X * skipws()     skips over "whitespace" (spaces or tabs), but
X *        not skip over the end of the line.  It skips over
X *        TOK_SEP, however (though that shouldn't happen).
X * scanid()     reads the next token (C identifier) into tokenbuf.
X *        The caller has already read the first character of
X *        the identifier.  Unlike macroid(), the token is
X *        never expanded.
X * macroid()    reads the next token (C identifier) into tokenbuf.
X *        If it is a #defined macro, it is expanded, and
X *        macroid() returns TRUE, otherwise, FALSE.
X * catenate()   Does the dirty work of token concatenation, TRUE if it did.
X * scanstring() Reads a string from the input stream, calling
X *        a user-supplied function for each character.
X *        This function may be output() to write the
X *        string to the output file, or save() to save
X *        the string in the work buffer.
X * scannumber() Reads a C numeric constant from the input stream,
X *        calling the user-supplied function for each
X *        character.  (output() or save() as noted above.)
X * save()       Save one character in the work[] buffer.
X * savestring() Saves a string in malloc() memory.
X * getfile()    Initialize a new FILEINFO structure, called when
X *        #include opens a new file, or a macro is to be
X *        expanded.
X * getmem()     Get a specified number of bytes from malloc memory.
X * output()     Write one character to stdout (calling putchar) --
X *        implemented as a function so its address may be
X *        passed to scanstring() and scannumber().
X * lookid()     Scans the next token (identifier) from the input
X *        stream.  Looks for it in the #defined symbol table.
X *        Returns a pointer to the definition, if found, or NULL
X *        if not present.  The identifier is stored in tokenbuf.
X * defnedel()   Define enter/delete subroutine.  Updates the
X *        symbol table.
X * get()        Read the next byte from the current input stream,
X *        handling end of (macro/file) input and embedded
X *        comments appropriately.  Note that the global
X *        instring is -- essentially -- a parameter to get().
X * cget()       Like get(), but skip over TOK_SEP.
X * unget()      Push last gotten character back on the input stream.
X * cerror(), cwarn(), cfatal(), cierror(), ciwarn()
X *        These routines format an print messages to the user.
X *        cerror & cwarn take a format and a single string argument.
X *        cierror & ciwarn take a format and a single int (char) argument.
X *        cfatal takes a format and a single string argument.
X */
X
X/*
X * This table must be rewritten for a non-Ascii machine.
X *
X * Note that several "non-visible" characters have special meaning:
X * Hex 1C QUOTE_PARM --a flag for # stringifying
X * Hex 1D DEF_MAGIC -- a flag to prevent #define recursion.
X * Hex 1E TOK_SEP   -- a delimiter for ## token concatenation
X * Hex 1F COM_SEP   -- a zero-width whitespace for comment concatenation
X */
X#if TOK_SEP != 0x1E || COM_SEP != 0x1F || DEF_MAGIC != 0x1D
X    << error type table isn't correct >>
X#endif
X
X#if OK_DOLLAR
X#define DOL    LET
X#else
X#define DOL    000
X#endif
X
Xchar type[256] = {        /* Character type codes    Hex        */
X   END,   000,     000,    000,   000,   000,   000,   000, /* 00        */
X   000,   SPA,     000,    000,   000,   000,   000,   000, /* 08        */
X   000,   000,     000,    000,   000,   000,   000,   000, /* 10        */
X   000,   000,     000,    000,   000,   LET,   000,   SPA, /* 18        */
X   SPA,OP_NOT,     QUO,    000,   DOL,OP_MOD,OP_AND,   QUO, /* 20    !"#$%&' */
XOP_LPA,OP_RPA,OP_MUL,OP_ADD,   000,OP_SUB,   DOT,OP_DIV, /* 28 ()*+,-./ */
X   DIG,   DIG,     DIG,    DIG,   DIG,   DIG,   DIG,   DIG, /* 30 01234567 */
X   DIG,   DIG,OP_COL,    000, OP_LT, OP_EQ, OP_GT,OP_QUE, /* 38 89:;<=>? */
X   000,   LET,     LET,    LET,   LET,   LET,   LET,   LET, /* 40 @ABCDEFG */
X   LET,   LET,     LET,    LET,   LET,   LET,   LET,   LET, /* 48 HIJKLMNO */
X   LET,   LET,     LET,    LET,   LET,   LET,   LET,   LET, /* 50 PQRSTUVW */
X   LET,   LET,     LET,    000,   BSH,   000,OP_XOR,   LET, /* 58 XYZ[\]^_ */
X   000,   LET,     LET,    LET,   LET,   LET,   LET,   LET, /* 60 `abcdefg */
X   LET,   LET,     LET,    LET,   LET,   LET,   LET,   LET, /* 68 hijklmno */
X   LET,   LET,     LET,    LET,   LET,   LET,   LET,   LET, /* 70 pqrstuvw */
X   LET,   LET,     LET,    000, OP_OR,   000,OP_NOT,   000, /* 78 xyz{|}~    */
X   000,   000,     000,    000,   000,   000,   000,   000, /*   80 .. FF    */
X   000,   000,     000,    000,   000,   000,   000,   000, /*   80 .. FF    */
X   000,   000,     000,    000,   000,   000,   000,   000, /*   80 .. FF    */
X   000,   000,     000,    000,   000,   000,   000,   000, /*   80 .. FF    */
X   000,   000,     000,    000,   000,   000,   000,   000, /*   80 .. FF    */
X   000,   000,     000,    000,   000,   000,   000,   000, /*   80 .. FF    */
X   000,   000,     000,    000,   000,   000,   000,   000, /*   80 .. FF    */
X   000,   000,     000,    000,   000,   000,   000,   000, /*   80 .. FF    */
X};
X
Xskipnl()
X/*
X * Skip to the end of the current input line.
X */
X{
X    register int        c;
X
X    DBUG_ENTER ("skipnl");
X    do {                /* Skip to newline    */
X        c = get();
X    } while (c != '\n' && c != EOF_CHAR);
X    DBUG_VOID_RETURN;
X}
X
Xint
Xskipws()
X/*
X * Skip over whitespace
X */
X{
X    register int        c;
X
X    DBUG_ENTER ("skipws");
X    do {                /* Skip whitespace    */
X        c = get();
X#if COMMENT_INVISIBLE
X    } while (type[c] == SPA || c == COM_SEP);
X#else
X    } while (type[c] == SPA);
X#endif
X    DBUG_RETURN (c);
X}
X
Xscanid(c)
Xregister int    c;                /* First char of id    */
X/*
X * Get the next token (an id) into the token buffer.
X * Note: this code is duplicated in lookid().
X * Change one, change both.
X */
X{
X    register int ct;
X
X    DBUG_ENTER ("scanid");
X    if (c == DEF_MAGIC)                     /* Eat the magic token  */
X        c = get();                          /* undefiner.           */
X    ct = 0;
X    do
X      {
X        if (ct == tokenbsize)
X#ifdef amiga
X        /*
X         * Duplicate the action of incmem, which grows the area
X         * to the new size, reallocating and copying if necessary.
X         * The disadvantage of this emulation is that the copy is
X         * always done because we have no realloc().
X         */
X          {
X         extern char *malloc ();
X         extern char *memcpy ();
X         char *new = malloc ((unsigned) (1 + (tokenbsize *= 2)));
X         if (new == NULL) {
X            cfatal("Out of memory", NULLST);
X         } else {
X            memcpy (new, tokenbuf, ct);
X            free (tokenbuf);
X            tokenbuf = new;
X         }
X          }
X#else
X          tokenbuf = incmem (tokenbuf, 1 + (tokenbsize *= 2));
X#endif
X        tokenbuf[ct++] = c;
X        c = get();
X      }
X    while (type[c] == LET || type[c] == DIG);
X    unget();
X    tokenbuf[ct] = EOS;
X    DBUG_VOID_RETURN;
X}
X
Xint
Xmacroid(c)
Xregister int        c;
X/*
X * If c is a letter, scan the id.  if it's #defined, expand it and scan
X * the next character and try again.
X *
X * Else, return the character.    If type[c] is a LET, the token is in tokenbuf.
X */
X{
X    register DEFBUF *dp;
X
X    DBUG_ENTER ("macroid");
X    if (infile != NULL && infile->fp != NULL)
X        recursion = 0;
X    while (type[c] == LET && (dp = lookid(c)) != NULL) {
X        expand(dp);
X        c = get();
X    }
X    DBUG_RETURN (c);
X}
X
Xint
Xcatenate()
X/*
X * A token was just read (via macroid).
X * If the next character is TOK_SEP, concatenate the next token
X * return TRUE -- which should recall macroid after refreshing
X * macroid's argument.  If it is not TOK_SEP, unget() the character
X * and return FALSE.
X */
X{
X#if OK_CONCAT
X    register int        c;
X    register char        *token1;
X    int            save();
X#endif
X
X    DBUG_ENTER ("catenate");
X#if OK_CONCAT
X    if (get() != TOK_SEP) {                 /* Token concatenation  */
X        unget();
X        DBUG_RETURN (FALSE);
X    }
X    else {
X        token1 = savestring(tokenbuf);      /* Save first token     */
X        c = macroid(get());                 /* Scan next token      */
X        switch(type[c]) {                   /* What was it?         */
X        case LET:                /* An identifier, ...    */
X        if (strlen(token1) + strlen(tokenbuf) >= NWORK)
X            cfatal("work buffer overflow doing %s ##", token1);
X        sprintf(work, "%s%s", token1, tokenbuf);
X        break;
X
X        case DIG:                /* A number        */
X        case DOT:                /* Or maybe a float    */
X        strcpy(work, token1);
X        workp = work + strlen(work);
X#if 0
X        do {
X            save(c);
X        } while ((c = get()) != TOK_SEP);
X#else
X        scannumber(c, save);
X#endif
X        save(EOS);
X        break;
X
X        default:                /* An error, ...    */
X        if (isprint(c))
X            cierror("Strange character '%c' after ##", c);
X        else
X            cierror("Strange character (%d.) after ##", c);
X        strcpy(work, token1);
X        unget();
X        break;
X        }
X        /*
X         * work has the concatenated token and token1 has
X         * the first token (no longer needed).  Unget the
X         * new (concatenated) token after freeing token1.
X         * Finally, setup to read the new token.
X         */
X        free(token1);                       /* Free up memory       */
X        ungetstring(work);                  /* Unget the new thing, */
X        DBUG_RETURN (TRUE);
X    }
X#else
X    DBUG_RETURN (FALSE);                    /* Not supported        */
X#endif
X}
X
Xint
Xscanstring(delim, outfun)
Xregister int    delim;            /* ' or "                       */
Xint        (*outfun)();            /* Output function              */
X/*
X * Scan off a string.  Warning if terminated by newline or EOF.
X * outfun() outputs the character -- to a buffer if in a macro.
X * TRUE if ok, FALSE if error.
X */
X{
X    register int        c;
X
X    DBUG_ENTER ("scanstring");
X    instring = TRUE;        /* Don't strip comments         */
X    (*outfun)(delim);
X    while ((c = get()) != delim
X         && c != '\n'
X         && c != EOF_CHAR) {
X        (*outfun)(c);
X        if (c == '\\')
X        (*outfun)(get());
X    }
X    instring = FALSE;
X    if (c == delim) {
X        (*outfun)(c);
X        DBUG_RETURN (TRUE);
X    }
X    else {
X        cerror("Unterminated string", NULLST);
X        unget();
X        DBUG_RETURN (FALSE);
X    }
X}
X
Xscannumber(c, outfun)
Xregister int    c;                /* First char of number */
Xregister int    (*outfun)();                    /* Output/store func    */
X/*
X * Process a number.  We know that c is from 0 to 9 or dot.
X * Algorithm from Dave Conroy's Decus C.
X */
X{
X    register int    radix;            /* 8, 10, or 16     */
X    int        expseen;        /* 'e' seen in floater  */
X    int        signseen;        /* '+' or '-' seen      */
X    int        octal89;        /* For bad octal test    */
X    int        dotflag;        /* TRUE if '.' was seen */
X
X    DBUG_ENTER ("scannumber");
X    expseen = FALSE;            /* No exponent seen yet */
X    signseen = TRUE;            /* No +/- allowed yet    */
X    octal89 = FALSE;            /* No bad octal yet    */
X    radix = 10;                /* Assume decimal    */
X    if ((dotflag = (c == '.')) != FALSE) {  /* . something?         */
X        (*outfun)('.');                     /* Always out the dot   */
X        if (type[(c = get())] != DIG) {     /* If not a float numb, */
X        unget();                        /* Rescan strange char  */
X        DBUG_VOID_RETURN;        /* All done for now    */
X        }
X    }                    /* End of float test    */
X    else if (c == '0') {                    /* Octal or hex?        */
X        (*outfun)(c);                       /* Stuff initial zero   */
X        radix = 8;                /* Assume it's octal    */
X        c = get();                          /* Look for an 'x'      */
X        if (c == 'x' || c == 'X') {         /* Did we get one?      */
X        radix = 16;            /* Remember new radix    */
X        (*outfun)(c);                   /* Stuff the 'x'        */
X        c = get();                      /* Get next character   */
X        }
X    }
X    for (;;) {                              /* Process curr. char.  */
X        /*
X         * Note that this algorithm accepts "012e4" and "03.4"
X         * as legitimate floating-point numbers.
X         */
X        if (radix != 16 && (c == 'e' || c == 'E')) {
X        if (expseen)                    /* Already saw 'E'?     */
X            break;            /* Exit loop, bad nbr.    */
X        expseen = TRUE;         /* Set exponent seen    */
X        signseen = FALSE;        /* We can read '+' now  */
X        radix = 10;            /* Decimal exponent    */
X        }
X        else if (radix != 16 && c == '.') {
X        if (dotflag)                    /* Saw dot already?     */
X            break;            /* Exit loop, two dots    */
X        dotflag = TRUE;         /* Remember the dot    */
X        radix = 10;            /* Decimal fraction    */
X        }
X        else if (c == '+' || c == '-') {    /* 1.0e+10              */
X        if (signseen)                   /* Sign in wrong place? */
X            break;            /* Exit loop, not nbr.    */
X        /* signseen = TRUE; */        /* Remember we saw it    */
X        }
X        else {                /* Check the digit    */
X        switch (c) {
X        case '8': case '9':             /* Sometimes wrong      */
X            octal89 = TRUE;        /* Do check later    */
X        case '0': case '1': case '2': case '3':
X        case '4': case '5': case '6': case '7':
X            break;            /* Always ok        */
X
X        case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
X        case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
X            if (radix == 16)            /* Alpha's are ok only  */
X            break;            /* if reading hex.    */
X        default:            /* At number end    */
X            goto done;            /* Break from for loop    */
X        }                /* End of switch    */
X        }                    /* End general case    */
X        (*outfun)(c);                       /* Accept the character */
X        signseen = TRUE;            /* Don't read sign now  */
X        c = get();                          /* Read another char    */
X    }                    /* End of scan loop    */
X    /*
X     * When we break out of the scan loop, c contains the first
X     * character (maybe) not in the number.  If the number is an
X     * integer, allow a trailing 'L' for long and/or a trailing 'U'
X     * for unsigned.  If not those, push the trailing character back
X     * on the input stream.  Floating point numbers accept a trailing
X     * 'L' for "long double".
X     */
Xdone:    if (dotflag || expseen) {               /* Floating point?      */
X        if (c == 'l' || c == 'L') {
X        (*outfun)(c);
X        c = get();                      /* Ungotten later       */
X        }
X    }
X    else {                    /* Else it's an integer */
X        /*
X         * We know that dotflag and expseen are both zero, now:
X         * dotflag signals "saw 'L'", and
X         * expseen signals "saw 'U'".
X         */
X        for (;;) {
X        switch (c) {
X        case 'l':
X        case 'L':
X            if (dotflag)
X            goto nomore;
X            dotflag = TRUE;
X            break;
X
X        case 'u':
X        case 'U':
X            if (expseen)
X            goto nomore;
X            expseen = TRUE;
X            break;
X
X        default:
X            goto nomore;
X        }
X        (*outfun)(c);                   /* Got 'L' or 'U'.      */
X        c = get();                      /* Look at next, too.   */
X        }
X    }
Xnomore: unget();                                /* Not part of a number */
X    if (octal89 && radix == 8)
X        cwarn("Illegal digit in octal number", NULLST);
X    DBUG_VOID_RETURN;
X}
X
Xsave(c)
Xregister int    c;
X{
X    if (workp >= &work[NWORK])
X        cfatal("Work buffer overflow", NULLST);
X    else *workp++ = c;
X}
X
Xchar *
Xsavestring(text)
Xchar        *text;
X/*
X * Store a string into free memory.
X */
X{
X    register char    *result;
X
X    DBUG_ENTER ("savestring");
X    result = getmem(strlen(text) + 1);
X    strcpy(result, text);
X    DBUG_RETURN (result);
X}
X
XFILEINFO    *
Xgetfile(bufsize, name)
Xint        bufsize;        /* Line or define buffer size    */
Xchar        *name;            /* File or macro name string    */
X/*
X * Common FILEINFO buffer initialization for a new file or macro.
X */
X{
X    register FILEINFO    *file;
X    register int        size;
X
X    DBUG_ENTER ("getfile");
X    size = strlen(name);                    /* File/macro name      */
X    file = (FILEINFO *) getmem((int)(sizeof (FILEINFO) + bufsize + size));
X    file->parent = infile;            /* Chain files together */
X    file->fp = NULL;            /* No file yet        */
X    file->filename = savestring(name);      /* Save file/macro name */
X    file->progname = NULL;            /* No #line seen yet    */
X    file->unrecur = 0;            /* No macro fixup    */
X    file->bptr = file->buffer;        /* Initialize line ptr    */
X    file->buffer[0] = EOS;            /* Force first read    */
X    file->line = 0;             /* (Not used just yet)  */
X    if (infile != NULL)                     /* If #include file     */
X        infile->line = line;        /* Save current line    */
X    infile = file;                /* New current file    */
X    line = 1;                /* Note first line    */
X    DBUG_RETURN (file);                     /* All done.            */
X}
X
Xchar *
Xgetmem(size)
Xint        size;
X/*
X * Get a block of free memory.
X */
X{
X    register char    *result;
X    extern char    *malloc();
X
X    DBUG_ENTER ("getmem");
X    if ((result = malloc((unsigned) size)) == NULL)
X        cfatal("Out of memory", NULLST);
X    DBUG_RETURN (result);
X}
X
X#ifndef amiga
Xchar *
Xincmem(obj,size)
Xchar        *obj;
Xint        size;
X/*
X * Get a block of free memory.
X */
X{
X    register char    *result;
X    extern char    *realloc();
X
X    DBUG_ENTER ("incmem");
X    if ((result = realloc(obj, (unsigned) size)) == NULL)
X        cfatal("Out of memory", NULLST);
X    DBUG_RETURN (result);
X}
X#endif /* amiga */
X
X/*
X *            C P P    S y m b o l   T a b l e s
X */
X
X/*
X * SBSIZE defines the number of hash-table slots for the symbol table.
X * It must be a power of 2.
X */
X#ifndef SBSIZE
X#define SBSIZE    64
X#endif
X#define SBMASK    (SBSIZE - 1)
X#if (SBSIZE ^ SBMASK) != ((SBSIZE * 2) - 1)
X    << error, SBSIZE must be a power of 2 >>
X#endif
X
Xstatic DEFBUF    *symtab[SBSIZE];    /* Symbol table queue headers    */
X
XDEFBUF *
Xlookid(c)
Xint    c;                /* First character of token    */
X/*
X * Look for the next token in the symbol table.  Returns token in tokenbuf.
X * If found, returns the table pointer;  Else returns NULL.
X */
X{
X    register int        nhash;
X    register DEFBUF     *dp;
X    register int        ct;
X    int            temp;
X    int            isrecurse;    /* For #define foo foo    */
X
X    DBUG_ENTER ("lookid");
X    nhash = 0;
X    if ((isrecurse = (c == DEF_MAGIC)))     /* If recursive macro   */
X        c = get();                          /* hack, skip DEF_MAGIC */
X    ct = 0;
X    do
X      {
X        if (ct == tokenbsize)
X#ifdef amiga
X        /*
X         * Duplicate the action of incmem, which grows the area
X         * to the new size, reallocating and copying if necessary.
X         * The disadvantage of this emulation is that the copy is
X         * always done because we have no realloc().
X         */
X          {
X         extern char *malloc ();
X         extern char *memcpy ();
X         char *new = malloc ((unsigned) (1 + (tokenbsize *= 2)));
X         if (new == NULL) {
X            cfatal("Out of memory", NULLST);
X         } else {
X            memcpy (new, tokenbuf, ct);
X            free (tokenbuf);
X            tokenbuf = new;
X         }
X          }
X#else
X          tokenbuf = incmem(tokenbuf, 1 + (tokenbsize *= 2));
X#endif
X        tokenbuf[ct++] = c;     /* Store token byte    */
X        nhash += c;         /* Update hash value    */
X        c = get();
X      }
X    while (type[c] == LET || type[c] == DIG);
X    unget();                                /* Rescan terminator    */
X    tokenbuf[ct] = EOS;            /* Terminate token    */
X    if (isrecurse)                          /* Recursive definition */
X        DBUG_RETURN (NULL);                 /* undefined just now   */
X    nhash += ct;                /* Fix hash value    */
X    dp = symtab[nhash & SBMASK];        /* Starting bucket    */
X    while (dp != (DEFBUF *) NULL) {         /* Search symbol table  */
X        if (dp->hash == nhash               /* Fast precheck        */
X         && (temp = strcmp(dp->name, tokenbuf)) >= 0)
X        break;
X        dp = dp->link;            /* Nope, try next one    */
X    }
X    DBUG_RETURN ((temp == 0) ? dp : NULL);
X}
X
XDEFBUF *
Xdefendel(name, delete)
Xchar        *name;
Xint        delete;         /* TRUE to delete a symbol    */
X/*
X * Enter this name in the lookup table (delete = FALSE)
X * or delete this name (delete = TRUE).
X * Returns a pointer to the define block (delete = FALSE)
X * Returns NULL if the symbol wasn't defined (delete = TRUE).
X */
X{
X    register DEFBUF     *dp;
X    register DEFBUF     **prevp;
X    register char        *np;
X    int            nhash;
X    int            temp;
X    int            size;
X
X    DBUG_ENTER ("defendel");
X    for (nhash = 0, np = name; *np != EOS;)
X        nhash += *np++;
X    size = (np - name);
X    nhash += size;
X    prevp = &symtab[nhash & SBMASK];
X    while ((dp = *prevp) != (DEFBUF *) NULL) {
X        if (dp->hash == nhash
X         && (temp = strcmp(dp->name, name)) >= 0) {
X        if (temp > 0)
X            dp = NULL;            /* Not found        */
X        else {
X            *prevp = dp->link;        /* Found, unlink and    */
X            if (dp->repl != NULL)       /* Free the replacement */
X            free(dp->repl);         /* if any, and then     */
X            free((char *) dp);          /* Free the symbol      */
X        }
X        break;
X        }
X        prevp = &dp->link;
X    }
X    if (!delete) {
X        dp = (DEFBUF *) getmem((int) (sizeof (DEFBUF) + size));
X        dp->link = *prevp;
X        *prevp = dp;
X        dp->hash = nhash;
X        dp->repl = NULL;
X        dp->nargs = 0;
X        strcpy(dp->name, name);
X    }
X    DBUG_RETURN (dp);
X}
X
X#if DEBUG
X
Xdumpdef(why)
Xchar        *why;
X{
X    register DEFBUF     *dp;
X    register DEFBUF     **syp;
X
X    DBUG_ENTER ("dumpdef");
X    printf("CPP symbol table dump %s\n", why);
X    for (syp = symtab; syp < &symtab[SBSIZE]; syp++) {
X        if ((dp = *syp) != (DEFBUF *) NULL) {
X        printf("symtab[%d]\n", (syp - symtab));
X        do {
X            dumpadef((char *) NULL, dp);
X        } while ((dp = dp->link) != (DEFBUF *) NULL);
X        }
X    }
X    DBUG_VOID_RETURN;
X}
X
Xdumpadef(why, dp)
Xchar        *why;            /* Notation            */
Xregister DEFBUF *dp;
X{
X    register char        *cp;
X    register int        c;
X
X    DBUG_ENTER ("dumpadef");
X    printf(" \"%s\" [%d]", dp->name, dp->nargs);
X    if (why != NULL)
X        printf(" (%s)", why);
X    if (dp->repl != NULL) {
X        printf(" => ");
X        for (cp = dp->repl; (c = *cp++ & 0xFF) != EOS;) {
X        if (c >= MAC_PARM && c <= (MAC_PARM + PAR_MAC))
X            printf("<%d>", c - MAC_PARM);
X        else if (isprint(c) || c == '\n' || c == '\t')
X            putchar(c);
X        else if (c < ' ')
X            printf("<^%c>", c + '@');
X        else
X            printf("<\\0%o>", c);
X        }
X    }
X    else {
X        printf(", no replacement.");
X    }
X    putchar('\n');
X    DBUG_VOID_RETURN;
X}
X#endif
X
Xoutdefines()
X{
X    register DEFBUF     *dp;
X    register DEFBUF     **syp;
X
X    DBUG_ENTER ("outdefines");
X    deldefines();                   /* Delete built-in #defines     */
X    for (syp = symtab; syp < &symtab[SBSIZE]; syp++) {
X        if ((dp = *syp) != (DEFBUF *) NULL) {
X        do {
X            outadefine(dp);
X        } while ((dp = dp->link) != (DEFBUF *) NULL);
X        }
X    }
X    DBUG_VOID_RETURN;
X}
X
Xoutadefine(dp)
Xregister DEFBUF *dp;
X{
X    register char        *cp;
X    register int        c;
X
X    DBUG_ENTER ("outadefine");
X    printf("#define %s", dp->name);
X    if (dp->nargs > 0) {
X        register int i;
X        printf("(");
X        for (i = 1; i < dp->nargs; i++) {
X        printf("__%d,", i);
X        }
X        printf("__%d)", i);
X    } else if (dp->nargs == 0) {
X        printf("()");
X    }
X    if (dp->repl != NULL) {
X        printf("\t");
X        for (cp = dp->repl; (c = *cp++ & 0xFF) != EOS;) {
X        if (c >= MAC_PARM && c < (MAC_PARM + PAR_MAC))
X            printf("__%d", c - MAC_PARM + 1);
X        else if (isprint(c) || c == '\t' || c == '\n')
X            putchar(c);
X        else switch (c) {
X        case QUOTE_PARM:
X            printf("#");
X            break;
X        case DEF_MAGIC:         /* Special anti-recursion */
X        case MAC_PARM + PAR_MAC:    /* Special "arg" marker */
X            break;
X        case COM_SEP:
X#if COMMENT_INVISIBLE
X            printf("/**/");
X#else
X            printf(" ");
X#endif
X            break;
X        case TOK_SEP:
X            printf("##");
X            break;
X        default:
X            printf("\\0%o", c);
X        }
X        }
X    }
X    putchar('\n');
X    DBUG_VOID_RETURN;
X}
X
X/*
X *            G E T
X */
X
Xint
Xget()
X/*
X * Return the next character from a macro or the current file.
X * Handle end of file from #include files.
X */
X{
X    register int        c;
X    register FILEINFO    *file;
X    register int        popped;     /* Recursion fixup    */
X    extern char        *fgets ();
X
X    DBUG_ENTER ("get");
X    popped = 0;
Xget_from_file:
X    if ((file = infile) == NULL)
X        DBUG_RETURN (EOF_CHAR);
Xnewline:
X#if 0
X    printf("get(%s), recursion %d, line %d, bptr = %d, buffer \"%s\"\n",
X        file->filename, recursion, line,
X        file->bptr - file->buffer, file->buffer);
X#endif
X    /*
X     * Read a character from the current input line or macro.
X     * At EOS, either finish the current macro (freeing temp.
X     * storage) or read another line from the current input file.
X     * At EOF, exit the current file (#include) or, at EOF from
X     * the cpp input file, return EOF_CHAR to finish processing.
X     */
X    if ((c = *file->bptr++ & 0xFF) == EOS) {
X        /*
X         * Nothing in current line or macro.  Get next line (if
X         * input from a file), or do end of file/macro processing.
X         * In the latter case, jump back to restart from the top.
X         */
X        if (file->fp == NULL) {             /* NULL if macro        */
X        popped++;
X        recursion -= file->unrecur;
X        if (recursion < 0)
X            recursion = 0;
X        infile = file->parent;        /* Unwind file chain    */
X        }
X        else {                /* Else get from a file */
X        if ((file->bptr = fgets(file->buffer, NBUFF, file->fp))
X            != NULL) {
X#if DEBUG
X            if (debug > 1) {            /* Dump it to stdout    */
X            printf("\n#line %d (%s), %s",
X                line, file->filename, file->buffer);
X            }
X#endif
X            goto newline;        /* process the line    */
X        }
X        else {
X            fclose(file->fp);           /* Close finished file  */
X            if ((infile = file->parent) != NULL) {
X            /*
X             * There is an "ungotten" newline in the current
X             * infile buffer (set there by doinclude() in
X             * cpp1.c).  Thus, we know that the mainline code
X             * is skipping over blank lines and will do a
X             * #line at its convenience.
X             */
X            wrongline = TRUE;    /* Need a #line now    */
X            }
X        }
X        }
X        /*
X         * Free up space used by the (finished) file or macro and
X         * restart input from the parent file/macro, if any.
X         */
X        free(file->filename);               /* Free name and        */
X        if (file->progname != NULL)         /* if a #line was seen, */
X        free(file->progname);           /* free it, too.        */
X        free((char *) file);                /* Free file space      */
X        if (infile == NULL)                 /* If at end of file    */
X        DBUG_RETURN (EOF_CHAR);         /* Return end of file   */
X        line = infile->line;        /* Reset line number    */
X        goto get_from_file;         /* Get from the top.    */
X    }
X    /*
X     * Common processing for the new character.
X     */
X    if (c == DEF_MAGIC && file->fp != NULL) /* Don't allow delete   */
X        goto newline;            /* from a file        */
X    if (file->parent != NULL) {             /* Macro or #include    */
X        if (popped != 0)
X        file->parent->unrecur += popped;
X        else {
X        recursion -= file->parent->unrecur;
X        if (recursion < 0)
X            recursion = 0;
X        file->parent->unrecur = 0;
X        }
X    }
X    if (c == '\n')                          /* Maintain current     */
X        ++line;                /* line counter     */
X    if (instring)                           /* Strings just return  */
X        DBUG_RETURN (c);                    /* the character.       */
X    else if (c == '/') {                    /* Comment?             */
X        instring = TRUE;            /* So get() won't loop  */
X        if ((c = get()) != '*') {           /* Next byte '*'?       */
X        instring = FALSE;        /* Nope, no comment    */
X        unget();                        /* Push the char. back  */
X        DBUG_RETURN ('/');              /* Return the slash     */
X        }
X        if (keepcomments) {                 /* If writing comments  */
X        putchar('/');                   /* Write out the        */
X        putchar('*');                   /*   initializer        */
X        }
X        for (;;) {                          /* Eat a comment        */
X        c = get();
Xtest:        if (keepcomments && c != EOF_CHAR)
X            cput(c);
X        switch (c) {
X        case EOF_CHAR:
X            cerror("EOF in comment", NULLST);
X            DBUG_RETURN (EOF_CHAR);
X
X#ifdef NOTDEF
X        case '/':
X            if ((c = get()) != '*')     /* Don't let comments   */
X            goto test;        /* Nest.        */
X            cwarn("Nested comments", NULLST);
X#endif /* NOTDEF */
X                        /* Fall into * stuff    */
X        case '*':
X            if ((c = get()) != '/')     /* If comment doesn't   */
X            goto test;        /* end, look at next    */
X            instring = FALSE;        /* End of comment,    */
X            if (keepcomments) {         /* Put out the comment  */
X            cput(c);                /* terminator, too      */
X            }
X            /*
X             * A comment is syntactically "whitespace" --
X             * however, there are certain strange sequences
X             * such as
X             *        #define foo(x)  (something)
X             *            foo|* comment *|(123)
X             *         these are '/' ^           ^
X             * where just returning space (or COM_SEP) will cause
X             * problems.  This can be "fixed" by overwriting the
X             * '/' in the input line buffer with ' ' (or COM_SEP)
X             * but that may mess up an error message.
X             * So, we peek ahead -- if the next character is
X             * "whitespace" we just get another character, if not,
X             * we modify the buffer.  All in the name of purity.
X             */
X            if (*file->bptr == '\n'
X             || type[*file->bptr & 0xFF] == SPA)
X            goto newline;
X#if COMMENT_INVISIBLE
X            /*
X             * Return magic (old-fashioned) syntactic space.
X             */
X            DBUG_RETURN ((file->bptr[-1] = COM_SEP));
X#else
X            DBUG_RETURN ((file->bptr[-1] = ' '));
X#endif
X
X        case '\n':                      /* we'll need a #line   */
X            if (!keepcomments)
X            wrongline = TRUE;    /* later...        */
X        default:            /* Anything else is    */
X            break;            /* Just a character    */
X        }                /* End switch        */
X        }                    /* End comment loop    */
X    }                    /* End if in comment    */
X    else if (!inmacro && c == '\\') {       /* If backslash, peek   */
X        if ((c = get()) == '\n') {          /* for a <nl>.  If so,  */
X        wrongline = TRUE;
X        goto newline;
X        }
X        else {                /* Backslash anything    */
X        unget();                        /* Get it later         */
X        DBUG_RETURN ('\\');             /* Return the backslash */
X        }
X    }
X    else if (c == '\f' || c == VT)          /* Form Feed, Vertical  */
X        c = ' ';                            /* Tab are whitespace   */
X    DBUG_RETURN (c);                        /* Just return the char */
X}
X
Xunget()
X/*
X * Backup the pointer to reread the last character.  Fatal error
X * (code bug) if we backup too far.  unget() may be called,
X * without problems, at end of file.  Only one character may
X * be ungotten.  If you need to unget more, call ungetstring().
X */
X{
X    register FILEINFO    *file;
X
X    DBUG_ENTER ("unget");
X    if ((file = infile) == NULL)
X        DBUG_VOID_RETURN;        /* Unget after EOF        */
X    if (--file->bptr < file->buffer)
X        cfatal("Too much pushback", NULLST);
X    if (*file->bptr == '\n')        /* Ungetting a newline?         */
X        --line;            /* Unget the line number, too    */
X    DBUG_VOID_RETURN;
X}
X
Xungetstring(text)
Xchar        *text;
X/*
X * Push a string back on the input stream.  This is done by treating
X * the text as if it were a macro.
X */
X{
X    register FILEINFO    *file;
X    extern FILEINFO     *getfile();
X
X    DBUG_ENTER ("ungetstring");
X    file = getfile(strlen(text) + 1, "");
X    strcpy(file->buffer, text);
X    DBUG_VOID_RETURN;
X}
X
Xint
Xcget()
X/*
X * Get one character, absorb "funny space" after comments or
X * token concatenation
X */
X{
X    register int    c;
X
X    DBUG_ENTER ("cget");
X    do {
X        c = get();
X#if COMMENT_INVISIBLE
X    } while (c == TOK_SEP || c == COM_SEP);
X#else
X    } while (c == TOK_SEP);
X#endif
X    DBUG_RETURN (c);
X}
X
X/*
X * Error messages and other hacks.  The first byte of severity
X * is 'S' for string arguments and 'I' for int arguments.  This
X * is needed for portability with machines that have int's that
X * are shorter than  char *'s.
X */
X
Xstatic
Xdomsg(severity, format, arg)
Xchar        *severity;        /* "Error", "Warning", "Fatal"  */
Xchar        *format;        /* Format for the error message */
Xchar        *arg;            /* Something for the message    */
X/*
X * Print filenames, macro names, and line numbers for error messages.
X */
X{
X    register char        *tp;
X    register FILEINFO    *file;
X
X    DBUG_ENTER ("domsg");
X    for (file = infile; file && !file->fp; file = file->parent)
X      ;
X    tp = file ? file->filename : 0;
X    fprintf (stderr, "%s\"%s\", line %d: %s: ",
X         MSG_PREFIX, tp, line, &severity[1]);
X    if (*severity == 'S')
X      fprintf(stderr, format, arg);
X    else
X      fprintf(stderr, format, (int) arg);
X    putc('\n', stderr);
X
X    if (file)   /*OIS*0.92*/
X    while ((file = file->parent) != NULL) { /* Print #includes, too */
X        tp = file->parent ? "," : ".";
X        if (file->fp == NULL)
X        fprintf(stderr, " from macro %s%s\n", file->filename, tp);
X        else {
X        fprintf(stderr, " from file %s, line %d%s\n",
X            (file->progname != NULL)
X            ? file->progname : file->filename,
X            file->line, tp);
X        }
X    }
X    DBUG_VOID_RETURN;
X}
X
Xcerror(format, sarg)
Xchar        *format;
Xchar        *sarg;        /* Single string argument        */
X/*
X * Print a normal error message, string argument.
X */
X{
X    DBUG_ENTER ("cerror");
X    domsg("SError", format, sarg);
X    errors++;
X    DBUG_VOID_RETURN;
X}
X
Xcierror(format, narg)
Xchar        *format;
Xint        narg;        /* Single numeric argument        */
X/*
X * Print a normal error message, numeric argument.
X */
X{
X    DBUG_ENTER ("cierror");
X    domsg("IError", format, (char *) narg);
X    errors++;
X    DBUG_VOID_RETURN;
X}
X
Xcfatal(format, sarg)
Xchar        *format;
Xchar        *sarg;            /* Single string argument    */
X/*
X * A real disaster
X */
X{
X    DBUG_ENTER ("cfatal");
X    domsg("SFatal error", format, sarg);
X    exit(IO_ERROR);
X    DBUG_VOID_RETURN;
X}
X
Xcwarn(format, sarg)
Xchar        *format;
Xchar        *sarg;            /* Single string argument    */
X/*
X * A non-fatal error, string argument.
X */
X{
X    DBUG_ENTER ("cwarn");
X    domsg("SWarning", format, sarg);
X    DBUG_VOID_RETURN;
X}
X
Xciwarn(format, narg)
Xchar        *format;
Xint        narg;            /* Single numeric argument    */
X/*
X * A non-fatal error, numeric argument.
X */
X{
X    DBUG_ENTER ("ciwarn");
X    domsg("IWarning", format, (char *) narg);
X    DBUG_VOID_RETURN;
X}
X
X#if amiga
X
Xchar *memcpy (s1, s2, n)
Xchar *s1, *s2;
Xint n;
X{
X    char *saves1 = s1;
X
X    DBUG_ENTER ("memcpy");
X    while (n-- > 0) {
X        *s1++ = *s2++;
X    }
X    DBUG_RETURN (saves1);
X}
X
X#endif /* amiga */
END_OF_FILE
if test 33823 -ne `wc -c <'Cpp6.c'`; then
    echo shar: \"'Cpp6.c'\" unpacked with wrong size!
fi
# end of 'Cpp6.c'
fi
echo shar: End of archive 5 \(of 5\).
cp /dev/null ark5isdone
MISSING=""
for I in 1 2 3 4 5 ; do
    if test ! -f ark${I}isdone ; then
    MISSING="${MISSING} ${I}"
    fi
done
if test "${MISSING}" = "" ; then
    echo You have unpacked all 5 archives.
    rm -f ark[1-9]isdone
else
    echo You still need to unpack the following archives:
    echo "        " ${MISSING}
fi
##  End of shell archive.
exit 0
--
Submissions to comp.sources.amiga and comp.binaries.amiga should be sent to:
    [e-mail]
or    [e-mail]    ( obsolescent mailers may need this address )
or    ...!uunet!xanth!amiga    ( very obsolescent mailers need this address )

Comments, questions, and suggestions s should be addressed to ``amiga-request''
(only use ``amiga'' for submissions) at the above addresses.